library(bigMap)

Load data

D <- as.matrix(read.csv('../sierpinski3d.mtx', sep = '', header = F))

Compute betas

g <- bdm.init(D, dSet.name = 'S3D', is.distance = T, ppx = 2030, threads = 4)
str(g)

Run ptSNE (perplexity = 2030, decreasing thread-ratio)

g1 <- bdm.ptsne(D, g, threads = 1, layers = 1)
g2 <- bdm.ptsne(D, g, threads = 3, layers = 2)
g3 <- bdm.ptsne(D, g, threads = 4, layers = 2)
g4 <- bdm.ptsne(D, g, threads = 5, layers = 2)
g5 <- bdm.ptsne(D, g, threads = 6, layers = 2)
g6 <- bdm.ptsne(D, g, threads = 8, layers = 2)
g.list <- list(g1, g2, g3, g4, g5, g6)
save(g.list, file = './fig2.RData')

Output

# source graph plot
source('../graphs.R')
# load edge matrix
E <- as.matrix(read.csv('../sierpinski3d.edg', sep = '', header = F))
# plot
nulL <- lapply(g.list, function(g) graph.plot(g, E))

hl-Correlation

g.list <- lapply(g.list, function(g) bdm.hlCorr(D, g, zSampleSize = 1000, threads = 4))
save(g.list, file = './fig2.RData')
hlTable <- sapply(g.list, function(g) summary(g$hlC))
hlTable <- t(round(hlTable, 4))
threadRatio <- sapply(g.list, function(g) g$ptsne$layers /g$ptsne$threads)
rownames(hlTable) <- round(threadRatio, 2)
knitr::kable(hlTable, caption = 'hl-Correlation by thread-ratio') %>%
  kable_styling(full_width = F)
hl-Correlation by thread-ratio
Min. 1st Qu. Median Mean 3rd Qu. Max.
1 0.7544 0.7544 0.7544 0.7544 0.7544 0.7544
0.67 0.7456 0.7491 0.7526 0.7518 0.7550 0.7573
0.5 0.7459 0.7497 0.7540 0.7541 0.7583 0.7623
0.4 0.7438 0.7462 0.7469 0.7500 0.7522 0.7609
0.33 0.7375 0.7492 0.7506 0.7510 0.7514 0.7671
0.25 0.7398 0.7460 0.7488 0.7485 0.7508 0.7583

Kary-neighborhood preservation

g.list <- lapply(g.list, function(g) bdm.knp(D, g, k.max = NULL, sampling = 0.9, threads = 4))
save(g.list, file = './fig2.RData')
bdm.knp.plot(g.list, ppxfrmt = 0)

Running Times

rTimes <- sapply(g.list, function(g) c(g$ppx$t[3], g$t$epoch, g$t$ptsne[3], sum(c(g$ppx$t[3], g$t$ptsne[3]))))
rTimes <- round(rTimes, 2)
threadRatio <- sapply(g.list, function(g) g$ptsne$layers /g$ptsne$threads)
colnames(hlTable) <- round(threadRatio, 2)
rownames(rTimes) <- c('betas', 'epoch', 'ptSNE', 'total')
knitr::kable(rTimes, caption = 'Computation times (s) by thread-ratio') %>%
  kable_styling(full_width = F)
Computation times (s) by thread-ratio
betas 0.42 0.42 0.42 0.42 0.42 0.42
epoch 1.91 0.92 0.61 0.49 0.39 0.30
ptSNE 92.26 44.30 29.38 23.89 18.82 14.84
total 92.67 44.71 29.79 24.30 19.24 15.26

Run on: Intel(R) Xeon(R) CPU E31225 @ 3.10GHz, 4 cores, 16GB RAM.